home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Arsenal Files 6
/
The Arsenal Files 6 (Arsenal Computer).ISO
/
prg_basi
/
n_b-v200.zip
/
NBT2
/
DMO
/
TINPUT.DMO
< prev
next >
Wrap
Text File
|
1996-03-11
|
11KB
|
269 lines
$if 0
┌──────────────────────────╖ PowerBASIC v3.20
┌──┤ DASoft ╟──────────────────────┬──────────────────╖
│ ├──────────────────────────╢ Copyright 1995 │ DATE: 1995-10-01 ╟─╖
│ │ FILE NAME TINPUT .DMO ║ by ╘════════════════─ ║ ║
│ │ ║ Don Schullian, Jr. ║ ║
│ ╘══════════════════════════╝ ║ ║
│ A license is hereby granted to the holder to use this source code in ║ ║
│ any program, commercial or otherwise, without receiving the express ║ ║
│ permission of the copyright holder and without paying any royalties, ║ ║
│ as long as this code is not distributed in any compilable format. ║ ║
│ IE: source code files, PowerBASIC Unit files, and printed listings ║ ║
╘═╤═════════════════════════════════════════════════════════════════════╝ ║
│ .................................... ║
╘═══════════════════════════════════════════════════════════════════════╝
$endif
'.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°.°
' ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °
$INCLUDE "DAS-NB01.INC"
$INCLUDE "DAS-NB02.INC"
$INCLUDE "DAS-NBT1.INC"
$INCLUDE "DAS-NBT2.INC"
$INCLUDE "DMO\TINPUT2.INC"
SCREEN 0,,0,0
COLOR 0,7,7
CLS
DIM tCC AS SHARED CountryCodeTYPE
LSET tCC = fGetCountry$(0)
SetDateFormat tCC.DateFormat, tCC.DateSep
SetInsertMsg " INSERT .ON ", " INSERT (OFF", 24, 69
HelpLineSetup 24, 14, 52, 32
ON TIMER (1) GOSUB CLOCK
GOSUB InputScreen
GOSUB GatherData
PrintPrompts D$(), F$(), Prompt$()
S$ = CHR$(4,6,11,14)
StartFld% = 6
IF fTinput2%( D$(), F$(), S$, H$(), StartFld% ) = %F10_key THEN
' STORE NEW DATA
END IF
BYEBYE:
COLOR 7, 0, 0
LOCATE 1,1,0
CLS
END
' ──────────────────────────────────────────────────────────────────────────
' ────────── local stuff
' ──────────────────────────────────────────────────────────────────────────
' Generally, in a real program, I split the printing of prompts from the
' printing of data for 2 reasons:
' 1) the prompts only have to be done once (usually)
' 2) the one sub can serve for all the input screens
' As it appears here it also formats and displays the data. In a different
' format a similar sub could be used to check the data for range, load
' required fields with default values, etc. The .Just member of TinputTYPE
' comes in handy for these tasks.
' MURPHY'S LAW 1313.2
' Users will always try to input data in the wrong format!
SUB PrintPrompts( SEG D$(), SEG F$(), SEG Prompt$() ) LOCAL PUBLIC
LOCAL C?, Dyte??, L%, Last%, P$, X%
DIM tINP AS TinputTYPE
Last% = UBOUND( Prompt$(1) )
FOR X% = 1 TO Last%
LSET tINP = F$(X%)
Mask$ = MID$( F$(X%), 9 )
L% = LEN( Prompt$(X%) )
IF L% > 0 THEN
C? = tINP.Col - L% - 1
Tprint tINP.Row, C?, Prompt$(X%), 120
END IF
IF ( D$(X%) = "" ) AND ( tINP.MustBe > 0 ) THEN
P$ = STRING$( tINP.Cols, 95 )
ELSE
P$ = ""
END IF
SELECT CASE UCASE$( tINP.Style )
CASE "A", "M", "P"
IF D$(X%) > "" THEN P$ = D$(X%)
CASE "B"
IF D$(X%) <> "" THEN
TprintTEXT tINP.Row, tINP.Col, tINP.Misc, tINP.Cols, D$(X%), 1, 0, 0, 113
ELSE
TboxFILL tINP.Row, tINP.Col, tINP.Misc, tINP.Cols, 95, 113
END IF
ITERATE
CASE "D"
Dyte?? = fDate2Days??( D$(X%) )
IF ( Dyte?? = 0 ) AND ( tINP.MustBe > 0 ) THEN Dyte?? = fSYS2Days??
IF tINP.Cols = 10 THEN
P$ = fDAYS2DATE$( Dyte?? )
ELSE
P$ = fDAYS2DATE8$( Dyte?? )
END IF
IF Mask$ <> "" THEN
C? = ( Dyte?? MOD 7 ) + 1
P$ = fGetPiece$( Mask$, 124, C? ) + P$
END IF
CASE "H"
IF D$(X%) <> "" THEN P$ = fASCii2Hex$( D$(X%) )
CASE "N"
P$ = USING$( Mask$, VAL( D$(X%) ) )
CASE "Q"
IF D$(X%) <> "" THEN P$ = fQueryPrint$( 0, 0, 0, Mask$, D$(X%) )
CASE "T"
Tyme& = fTime2LongCk&( D$(X%) )
IF ( Tyme& = 0 ) AND ( tINP.MustBe > 0 ) THEN Tyme& = fSysT2long&
IF tINP.Cols <> 9 THEN
P$ = fLONG2Time$( Tyme& )
ELSE
P$ = fLONG2HM$ ( Tyme& )
END IF
END SELECT
TprintCLEAR tINP.Row, tINP.Col, tINP.Cols, P$, 113
NEXT
END SUB
' ──────────────────────────────────────────────────────────────────────────
FUNCTION fGetKey% LOCAL PUBLIC '┌────────────────────────────────────
LOCAL G% '│
'│centralize all incoming key-presses
DO '│
TIMER ON '│start the clock printing
WHILE NOT INSTAT : WEND '│rem this line out if used with EVENTs
TIMER STOP '│no need slowing down the program
G% = CVI(INKEY$ + CHR$(0)) '│read next key press
SELECT CASE G% '│
CASE 124 : G% = 0 '│ block the pipe "|"
END SELECT '│ do whatever else you want here!
LOOP UNTIL G% <> 0 '│
'│
FUNCTION = G% '│ RETURN VALUE
'│
END FUNCTION '└────────────────────────────────────
' ──────────────────────────────────────────────────────────────────────────
FUNCTION fJustify$ ( BYVAL V$, BYVAL L%, BYVAL Which% ) LOCAL PUBLIC
SELECT CASE Which%
CASE 01 : V$ = fRemoveDBLspc$( V$ )
V$ = fLRtrim$( V$ )
CASE 02 : V$ = fLRtrim$ ( V$ )
CASE 03 : V$ = fJustLeft$ ( V$, L%, 32 )
CASE 04 : V$ = fJustCenter$( V$, L%, 32 )
CASE 05 : V$ = fJustRight$ ( V$, L%, 32 )
CASE 06 : V$ = fJustRight$ ( V$, L%, 48 ) ' PAD LEFT W/ 0s
END SELECT
FUNCTION = V$
END FUNCTION
'───────────────────────────────────────────────────────────────────────────
'───── SIMULATED INPUT SCREEN PRINTER
'───────────────────────────────────────────────────────────────────────────
INPUTSCREEN:
' notice how you can use a 1 row box to make a message box
MakeTBox 1, 1, 1, 11, 0, 32, 51, 120, 2, "MAIN MENU"
MakeTBox 1, 14, 1, 52, 0, 31, 51, 120, 2, "EDITING CUSTOMER RECORDS"
MakeTBox 1, 68, 1, 12, 0, 32, 51, 120, 2, TIME$
MakeTBox 24, 1, 1, 11, 0, 32, 51, 120, 2, "F-1 HELP"
MakeTBox 24, 14, 1, 52, 0, 32, 51, 120, 2, "PRESS ANY KEY TO CONTINUE"
MakeTBox 24, 68, 1, 12, 0, 32, 51, 120, 2, fSYSdate$
RETURN
'───────────────────────────────────────────────────────────────────────────
'───── SIMULATED DATA GATHERING ROUTINE
'───────────────────────────────────────────────────────────────────────────
GATHERDATA:
' Under real conditions this data would be either read from a file or,
' at least, packed as a string to start with to make reading it much less
' arduous. ie: F$(5) = CHR$(81,07,69,06,01,0,0,0) + "NMF|N/D....."
' Also, the prompts would be stored and loaded separately. I use this
' style as it is easier to match prompts with field data.
RESTORE TESTINPUT
READ Last%
DIM F$( Last% ), Prompt$( Last% ), D$( Last% ), H$( Last% )
FOR X% = 1 TO Last%
READ Prompt$(X%)
READ F$(X%)
FOR Y% = 1 TO 7
READ D? : F$(X%) = F$(X%) + CHR$(D?)
NEXT
READ D$ : F$(X%) = F$(X%) + D$
NEXT
FOR X% = 1 TO Last%
READ H$(X%)
NEXT
D$(01) = "Schullian" ' This, basically, is how the data should be
D$(02) = "Donald A." ' presented to the input routine(s). There is
D$(03) = "Mr.,PhD" ' nothing stopping you from storing it on the
D$(04) = fDays2Date$(27753) ' disk in a different format. Field 11 could
D$(05) = "M" ' be stored as a single byte then converted to
D$(06) = "Grammou 33" ' a number when read in. Field 12 could be
D$(07) = "" ' stored as a single precision number. The 3
D$(08) = "Papagou" ' elements of the name could also be packed
D$(09) = "62301" ' into one field. SEE: StripName
D$(10) = "(301) 654-6200" '
D$(11) = "8" ' Some of these actions could be done in
D$(12) = "546" ' fJustify$, or some similar function, if the
D$(13) = fDays2Date8$(45000) ' requirement was great.
D$(14) = "" '
D$(15) = "D:\FILENAME.EXE" '
D$(16) = "@xPF" '
RETURN
'I ┌────────> STYLE
'N │ ┌───────> ROW
'P │ │ ┌──────> COL
'U │ │ │ ┌─────> COLS
'T │ │ │ │ ┌────> MUSTBE
'T │ │ │ │ │ ┌────> CASED
'Y │ │ │ │ │ │ ┌────> MISC
TESTINPUT: 'P │ │ │ │ │ │ │ ┌────> JUST
DATA 16 'E │ │ │ │ │ │ │ │ ┌────> MASK$
DATA "FAMILY NAME:" , "A", 05, 15, 40, 1, 0, 0, 1, ""
DATA "GIVEN NAME:" , "A", 06, 15, 25, 0, 0, 0, 1, ""
DATA "HONORIFICS:" , "A", 07, 15, 15, 0, 0, 0, 1, ""
DATA "BIRTH DATE:" , "D", 06, 69, 10, 1, 0, 0, 0, ""
DATA "SEX:" , "Q", 07, 69, 6, 1, 0, 0, 0, "NMF?|N/D|MALE|FEMALE|M,F,N"
DATA "ADDRESS:" , "A", 09, 15, 40, 0, 1, 0, 2, ""
DATA "" , "A", 10, 15, 40, 0, 1, 0, 2, ""
DATA "CITY:" , "A", 11, 15, 20, 0, 1, 0, 2, ""
DATA "ZIP:" , "M", 11, 44, 11, 0, 0, 0, 0, "NNNNN nnnnn"
DATA "PHONE:" , "M", 12, 15, 14, 1, 0, 0, 0, "(nnn) NNN-NNNN"
DATA "DISCOUNT: " , "A", 14, 19, 2, 0, 0, 0, 6, " 0123456789"
DATA "PAYMENT:" , "N", 15, 15, 9, 0, 0, 0, 0, "+#,###.##"
DATA "DUE DATE:" , "D", 15, 35, 12, 0, 0, 1, 0, "Sun |Mon |Tue |Wed |Thr |Fri |Sat "
DATA "NOTES:" , "B", 17, 15, 55, 0, 0, 2, 0, ""
DATA " FILE NAME:" , "P", 20, 15, 55, 0, 0,90, 0, ".:\"
DATA "PRINT CMDS:" , "H", 22, 15, 55, 0, 0,20, 0, ""
DATA "MANDATORY FIELD - CUSTOMER'S FAMILY NAME ONLY!"
DATA "CUSTOMER'S GIVEN NAME(S) AND MIDDLE INITIAL(S)"
DATA "Mr., Mrs., Dr., PhD. etc."
DATA "DATE OF BIRTH"
DATA "[M]ale [F]emale or [N]ot disclosed"
DATA "STREET ADDRESS, P.O. BOX, etc."
DATA "Apt N°, FLOOR, etc."
DATA "CITY NAME"
DATA "U.S.A. 11 DIGIT POSTAL CODE"
DATA "PHONE NUMBER WITH AREA CODE IF NOT LOCAL"
DATA "DISCOUNT PERCENTAGE"
DATA "FULL PAYMENT AMOUNT"
DATA "NEXT DUE DATE"
DATA "CREDIT INFORMATION AND/OR DELINQUENCY INFO"
DATA "ENTER DRIVE:\PATH\FILENAME.EXE"
DATA "HEX or DECIMAL VALUES FOR PRINTER COMMANDS"
CLOCK:
Tprint 1, 70, TIME$, 0
RETURN